Aminet 7/Aminet 7 - August 1995.iso/Aminet/comm/bbs/WWBBSDoors.lha/WWBBS/rexxDoors/Ship_Hunt.rexx

OS/2 REXX Batch file | 1995-04-27 | 19.6 KB | 725 lines

/* Ship_Hunt.rexx version 2.3 by Matt English 1-10-93
   This is an ONLINE game designed for the BBBBS system.
   This game is freely distributable as long as no one makes
   any money from it and the credits remain on the title screen.
   To run on BBBBS, just copy the program "Ship_Hunt.rexx"
   to your RexxDoors directory.
    For bug reports or comments call Matt English (sysop)
                                     Alternative BBS
                                     503-761-3043
*/

options results
FF='0C'x  /* FormFeed */
CR='0D'x  /* Carraige Return */
CALL TIME('R')
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

bbspath=GETCLIP('BBS_path')
bbspath=bbspath'rexxDoors/Data/'
datapath = bbspath'Ship'

PARSE arg Username winnings . colorflag secs .
IF secs='' THEN secs=3600
signal on syntax

BBSIDENTIFY EMULATION
PARSE VAR RESULT type .
if type = "ANSI" then
  colorflag=1
else
  colorflag=0

BBSIDENTIFY USER
PARSE VAR RESULT Username From Acces .
Name = substr(Username,2,length(Username)-2)

letters = 'abcdefghijq'

def=''
pen0=''
pen2=''
pen3=''
pen4=''
pen5=''
pen6=''
pen7=''
bak2=''
bak3=''
bak4=''
bak5=''
bak6=''
bak7=''
CLS = 'H'
UNL = ''

IF colorflag=1 THEN
  DO
    def=''
    pen0=''
    pen2=''
    pen3=''
    pen4=''
    pen5=''
    pen6=''
    pen7=''
    bak2=''
    bak3=''
    bak4=''
    bak5=''
    bak6=''
    bak7=''
    CLS = 'H'
    UNL = ''
  END

PPrompt = '2H'
pmess = '12H'
pmess2 = '12H'
pturn = '64H'
down.1 = '7H'
down.2 = '7H'
down.3 = '57H'
down.4 = '57H'

stline = 5
do aa = c2d('A') to c2d('J')
 al = d2c(aa)
 stpos = 28
 stline = stline + 1
 do bb = 1 to 10
  stpos = stpos + 2
  p.al.bb = ''stline';'stpos'H'
  end
 end

/* Open the support library if it is not already open. */
if ~show('L',"rexxsupport.library") then do
    addlib('rexxsupport.library',0,-30,0)
     end

wz = random(1,999,time('S')) /* initalize random number generator */

if ~exists(datapath) then makedir(datapath)
if ~exists(datapath'/winners') then do
 call open(win,datapath'/winners','w')
 top = 90
 do 10
  call writeln(win,''date()'... MATT_ENGLISH..... sank all the ships in 'top' shots!')
  top = top + 1
  end
 call close(win)
 end

say cr
say cr
say cr
say'                          'bak7''pen0' Welcome to Ship Hunt ! 'def''cr
say'                          'bak7''pen0'  version 2.3 1-10-93   'def''cr
say'                          'bak7''pen0'    by Matt English     'def''cr
say cr
say cr
call delay(100)
call showwin
say cr
' Type "I" for instructions or hit return to play > '
input=readstr()
if input ~= 'I' then call start
else call instructions
call start

showwin:
 call open(win,datapath'/winners','r')
 say'                   'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr
 say'                   'bak5''pen0'%       Top Ship Hunt Winners!       %'def''cr
 say'                   'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr
 say cr
 say cr
 do 10
  line = readln(win)
  call sac70''line''
  end
 call close(win)
 say cr
 call delay(200)
return

instructions:
 say cr
 say' This is a very simple game. The object is to sink the 5 ships'cr
 say' that the computer has hidden on a 10 x 10 grid. If you can sink'cr
 say' all the ships using less shots than a player on the WINNERS list,'cr
 say' your name will be added to the winners list and you''ll be famous!'cr
 say cr
 say' The computer will generate a new grid for each game played, so you''ll'cr
 say' never play the same game twice and no other player plays the same grid'cr
 say' that you''re playing. The ships are:'cr
 say'                                      Carrier...... 5 spots'cr
 say'                                      Battleship... 4 spots'cr
 say'                                      Destroyer.... 3 spots'cr
 say'                                      Submarine.... 3 spots'cr
 say'                                      PT Boat...... 2 spots'cr
 say cr
 say' If you decide to quit in the middle of a game, your stats will be'cr
 say' saved and you can pick up where you left off next time.'cr
 say cr
 call sac70'HAVE FUN!'
 say cr
 call pressreturn
 return

START:
shipsdown = ''
if ~exists(datapath'/'name) then do
 say'Stand by, setting up the game..'
 call setupdata
 end
if justsetup ~= 1 then do
 say cr
 prompt(' Would you like to continue your previous game? (Y,n) > ')
 answer=readstr()
 if answer = 'N' then do
  say' OK,Setting up a new game..'cr
  call setupdata
  end
 else do
  say cr
  say' OK, Loading your previous game...'cr
  say cr
  end
 end
call loaddata
say cr
if justsetup ~= 1 then say' You last played this game on 'pen7''lastplay''def''cr
call delay(100)
say cr
say cr
say cr
call play

Play:
 say cls
 say'               'pen5'                   'bak2'Ship Hunt'def''cr
 say cr
 say'                             1 2 3 4 5 6 7 8 9 10'cr
 say'  ' cr
 say'  'bak6''UNL'Ship       Size'def'        A   's.a.1' 's.a.2' 's.a.3' 's.a.4' 's.a.5' 's.a.6' 's.a.7' 's.a.8' 's.a.9' 's.a.10'        'bak4''UNL'Ships Sunk'def''cr
 say'  'bak6'               'def'        B   's.B.1' 's.B.2' 's.B.3' 's.B.4' 's.b.5' 's.b.6' 's.b.7' 's.b.8' 's.b.9' 's.b.10''cr
 say'  'bak6'Carrier      5 'def'        C   's.c.1' 's.c.2' 's.c.3' 's.c.4' 's.c.5' 's.c.6' 's.c.7' 's.c.8' 's.c.9' 's.c.10''cr
 say'  'bak6'Battleship   4 'def'        D   's.d.1' 's.d.2' 's.d.3' 's.d.4' 's.d.5' 's.d.6' 's.d.7' 's.d.8' 's.d.9' 's.d.10''cr
 say'  'bak6'Destroyer    3 'def'        E   's.e.1' 's.e.2' 's.e.3' 's.e.4' 's.e.5' 's.e.6' 's.e.7' 's.e.8' 's.e.9' 's.e.10''cr
 say'  'bak6'Submarine    3 'def'        F   's.f.1' 's.f.2' 's.f.3' 's.f.4' 's.f.5' 's.f.6' 's.f.7' 's.f.8' 's.f.9' 's.f.10''cr
 say'  'bak6'PT Boat      2 'def'        G   's.g.1' 's.g.2' 's.g.3' 's.g.4' 's.g.5' 's.g.6' 's.g.7' 's.g.8' 's.g.9' 's.g.10''cr
 say'                         H   's.h.1' 's.h.2' 's.h.3' 's.h.4' 's.h.5' 's.h.6' 's.h.7' 's.h.8' 's.h.9' 's.h.10''cr
 say'                         I   's.i.1' 's.i.2' 's.i.3' 's.i.4' 's.i.5' 's.i.6' 's.i.7' 's.i.8' 's.i.9' 's.i.10'        'pen3'"Q" = Quit'def''cr
 say'                         J   's.j.1' 's.j.2' 's.j.3' 's.j.4' 's.j.5' 's.j.6' 's.j.7' 's.j.8' 's.j.9' 's.j.10'        Turn #  'cr
 say cr
 say cr
 call clrl2
 call pullshotl

clrl:
 arg where
 call writech('STDOUT',''where'                                                              ')
 return

clrl2:
 call writech('STDOUT',''pmess''bak3'                                                  'def'')
 call writech('STDOUT',''pmess2''bak3'                                                  'def'')
 return

pullshotl:
 if shipsdown ~= '' then do sd = 1 to words(shipsdown)
  say''down.sd''word(shipsdown,sd)''
  end
 turns = turns + 1
 say''pturn''turns''
 prompt(''PPrompt'Enter your shot, Captain 'name' > ')
 theshot=readstr()
 CALL checkBBS()
 call clrl pprompt
 call clrl2
 theshot = strip(theshot)
 if theshot = 'Q' then call quit
 shotl = substr(theshot,1,1)
 shotn = strip(substr(theshot,2,2))
 if length(theshot) > 3 | if theshot = '' |  ~(instring(shotl,letters)) | ~datatype(shotn,'W') | shotn > 10 | shotn < 1 then do
  say''pmess'  'bak3' Please enter your shot in letter/number format'def''cr
  say''pmess2'  'bak3'              Examples: A3 B10 C4              'def''cr
  turns = turns - 1
  call pullshotl
  end
 call checkshot

Quit:
 turns = turns - 1
 say cr
 say''pmess''bak3'     OK, Saving your stats for next time....'def''cr
 call delay(50)
 if exists(datapath'/'name) then call delete(datapath'/'name)
 call open(stat,datapath'/'name,'w')
 call writeln(stat,pos.c)
 call writeln(stat,pos.b)
 call writeln(stat,pos.d)
 call writeln(stat,pos.s)
 call writeln(stat,pos.p)
 call writeln(stat,damage.c)
 call writeln(stat,damage.b)
 call writeln(stat,damage.d)
 call writeln(stat,damage.s)
 call writeln(stat,damage.p)
 call writeln(stat,shipssunk)
 call writeln(stat,hits)
 call writeln(stat,misses)
 call writeln(stat,lastplay)
 call writeln(stat,turns)
 call close(stat)
 say cr
 call showwin
 say cr
 say' 'pen2'Returning to the BBS...'def''
 say cr
 call delay(25)
 exit


checkBBS:
IF ADDRESS()~='BAUD' THEN RETURN 0
IF TIME('E')>secs THEN SIGNAL Quit
dcd
IF RC=0 THEN SIGNAL Quit
temp=secs-TIME('E')
IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
RETURN 0


showshot:
   gg = 0
   do 10
    gg = gg + 1
    if gg = 10 then gg = 0
    say''p.shotl.shotn''pen4''gg''def''cr
    say''p.shotl.shotn''pen5'&'def''cr
    say''p.shotl.shotn''pen6'#'def''cr
    end
    say''p.shotl.shotn'-'cr
return

checkshot:
 shot = shotl||shotn
 /* Check to see if this is a repeat shot */
 do w = 1 to words(hits)
  if word(hits,w) = shot then do
   say''pmess''bak3'           That spot has already been shot!'def''
   call delay(50)
   turns = turns - 1
   call pullshotl
   end
  end
 do y = 1 to words(misses)
  if word(misses,y) = shot then do
   say''pmess''bak3'           That spot has already been shot!'def''
   call delay(50)
   turns = turns - 1
   call pullshotl
   end
  end
/* Check to see if it's a hit */
 do w = 1 to words(pos.c)
  if word(pos.c,w) = shot then do
   s.shotl.shotn = ''pen3'X'def''
   hits = ''hits'' ''shot''
   damage.c = damage.c + 1
   call showshot
   call delay(25)
   say''p.shotl.shotn''s.shotl.shotn''cr
   say''pmess''bak3'       It''s a HIT!      Good shot captain!'def''
   if damage.c = 5 then do
    call delay(100)
    say''pmess2''bak3'           You just sank the Carrier!!!'def''
    call delay(100)
    shipsdown = shipsdown' Carrier'
    shipssunk = shipssunk + 1
    say cr
    if shipssunk = 5 then call GameOver
    end
   call pullshotl
   end
  end
 do w = 1 to words(pos.b)
  if word(pos.b,w) = shot then do
   s.shotl.shotn = ''pen3'X'def''
   hits = ''hits'' ''shot''
   damage.b = damage.b + 1
   call showshot
   call delay(25)
   say''p.shotl.shotn''s.shotl.shotn''cr
   say''pmess''bak3'        It''s a HIT!      Good shot captain!'def''
   if damage.b = 4 then do
    call delay(100)
    say''pmess2''bak3'         You just sank the Battleship!!!'def''
    call delay(100)
    shipsdown =shipsdown' Battleship'
    shipssunk = shipssunk + 1
    say cr
    if shipssunk = 5 then call GameOver
    end
   call pullshotl
   end
  end
 do w = 1 to words(pos.d)
  if word(pos.d,w) = shot then do
   s.shotl.shotn = ''pen3'X'def''
   hits = ''hits'' ''shot''
   damage.d = damage.d + 1
   call showshot
   call delay(25)
   say''p.shotl.shotn''s.shotl.shotn''cr
   say''pmess''bak3'        It''s a HIT!      Good shot captain!'def''
   if damage.d = 3 then do
    call delay(100)
    say''pmess2''bak3'          You just sank the Destroyer!!!'def''
    call delay(100)
    shipsdown = shipsdown' Destroyer'
    shipssunk = shipssunk + 1
    say cr
    if shipssunk = 5 then call GameOver
    end
   call pullshotl
   end
  end
 do w = 1 to words(pos.s)
  if word(pos.s,w) = shot then do
   s.shotl.shotn = ''pen3'X'def''
   hits = ''hits'' ''shot''
   damage.s = damage.s + 1
   call showshot
   call delay(25)
   say''p.shotl.shotn''s.shotl.shotn''cr
   say''pmess''bak3'        It''s a HIT!      Good shot captain!'def''
   if damage.s = 3 then do
    call delay(100)
    say''pmess2''bak3'           You just sank the Submarine!!!'def''
    call delay(100)
    shipsdown = shipsdown' Submarine'
    shipssunk = shipssunk + 1
    say cr
    if shipssunk = 5 then call GameOver
    end
   call pullshotl
   end
  end
 do w = 1 to words(pos.p)
  if word(pos.p,w) = shot then do
   s.shotl.shotn = ''pen3'X'def''
   hits = ''hits'' ''shot''
   damage.p = damage.p + 1
   call showshot
   call delay(25)
   say''p.shotl.shotn''s.shotl.shotn''cr
   say''pmess''bak3'        It''s a HIT!      Good shot captain!'def''
   if damage.p = 2 then do
    call delay(100)
    say''pmess2''bak3'            You just sank the PT Boat!!!'def''
    call delay(100)
    shipsdown = shipsdown' PT_Boat'
    shipssunk = shipssunk + 1
    say cr
    if shipssunk = 5 then call GameOver
    end
   call pullshotl
   end
  end
 s.shotl.shotn = ''pen2'*'def''
 misses = ''misses'' ''shot''
 call showshot
 call delay(25)
 say''p.shotl.shotn''s.shotl.shotn''cr
 say''pmess''bak3'               That shot was a MISS!!'def''
 say cr
 call delay(30)
 call pullshotl

Gameover:
 call sac70'You sank all the ships in 'turns' shots!'
 call delay(50)
 call sac70'Checking your score against the winners list, hold on...'
 say cr
 call checklist
 if madelist = 1 then call sac70'Congratulations, you made the winners list!'
 else call sac70'You didn''t quite make the winners list that time...'
 say cr
 call delete(datapath'/'name)
 prompt('  Would you like to play again? (Y,n) > ')
 again=readstr()
 if again ~= "N" then call start
 else do
  say cr
  call sac70'OK, thanks for playing.... Try again next time..'
  say cr
  call delay(25)
  call showwin
  say cr
  say' 'pen2'Returning to the BBS...'def''cr
  call delay(25)
  exit

checklist:
 madelist = 0
 call open(win,datapath'/winners','r')
 winline = ''date()'... 'left(name,17,".")' sank all the ships in 'left(turns,2)' shots!'
 do wl = 1 to 10
  line.wl = readln(win)
  end
 call close(win)
 if turns <= word(line.10,10) then do
  templine.10 = winline
  madelist = 1
  if turns <= word(line.9,10) then do
   templine.9 = winline
   templine.10 = line.9
   end
  else templine.9 = line.9
  if turns <= word(line.8,10) then do
   templine.8 = winline
   templine.9 = line.8
   end
  else templine.8 = line.8
  if turns <= word(line.7,10) then do
   templine.7 = winline
   templine.8 = line.7
   end
  else templine.7 = line.7
  if turns <= word(line.6,10) then do
   templine.6 = winline
   templine.7 = line.6
   end
  else templine.6 = line.6
  if turns <= word(line.5,10) then do
   templine.5 = winline
   templine.6 = line.5
   end
  else templine.5 = line.5
  if turns <= word(line.4,10) then do
   templine.4 = winline
   templine.5 = line.4
   end
  else templine.4 = line.4
  if turns <= word(line.3,10) then do
   templine.3 = winline
   templine.4 = line.3
   end
  else templine.3 = line.3
  if turns <= word(line.2,10) then do
   templine.2 = winline
   templine.3 = line.2
   end
  else templine.2 = line.2
  if turns <= word(line.1,10) then do
   templine.1 = winline
   templine.2 = line.1
   end
  else templine.1 = line.1
  call delete(datapath'/winners')
  call open(win,datapath'/winners','w')
  call writeln(win,templine.1)
  call writeln(win,templine.2)
  call writeln(win,templine.3)
  call writeln(win,templine.4)
  call writeln(win,templine.5)
  call writeln(win,templine.6)
  call writeln(win,templine.7)
  call writeln(win,templine.8)
  call writeln(win,templine.9)
  call writeln(win,templine.10)
  call close(win)
  end
return


loaddata:
 call open(data,datapath'/'name,'r')
 pos.c = readln(data)
 pos.b = readln(data)
 pos.d = readln(data)
 pos.s = readln(data)
 pos.p = readln(data)
 damage.c = readln(data)
 if damage.c = 5 then shipsdown = shipsdown' Carrier'
 damage.b = readln(data)
 if damage.b = 4 then shipsdown = shipsdown' Battleship'
 damage.d = readln(data)
 if damage.d = 3 then shipsdown = shipsdown' Destroyer'
 damage.s = readln(data)
 if damage.s = 3 then shipsdown = shipsdown' Submarine'
 damage.p = readln(data)
 if damage.p = 2 then shipsdown = shipsdown' PT_Boat'
 shipssunk = readln(data)
 hits = readln(data)
 misses = readln(data)
 lastplay = readln(data)
 turns = readln(data)
 call close(data)
 do z = c2d('A') to c2d('J')
  let = d2c(z)
  call writech(stdout,'.')
  do num = 1 to 10
   call writech(stdout,'.')
   do w = 1 to words(hits)
    if word(hits,w) = let||num then do
     s.let.num = ''pen3'X'def''
     iterate num
     end
    end
   do y = 1 to words(misses)
    if word(misses,y) = let||num then do
     s.let.num = ''pen2'*'def''
     iterate num
     end
    end
   s.let.num = ''pen6'.'def''
   end
  end
return

setupdata:
 if exists(datapath'/'name) then call delete(datapath'/'name)
 /* Setup the random locations of the ships */
 pos.c = ''
 pos.b = ''
 pos.d = ''
 pos.s = ''
 pos.p = ''
 call setships C 6 5    /* Carrier */
 call setships B 7 4    /* Battleship */
 call setships D 8 3    /* Destroyer */
 call setships S 8 3    /* Sub */
 call setships P 9 2    /* PT Boat */
 call open(data,datapath'/'name,'w')
 call writeln(data,pos.c)  /* ship positions */
 call writeln(data,pos.b)
 call writeln(data,pos.d)
 call writeln(data,pos.s)
 call writeln(data,pos.p)
 call writeln(data,'0')    /* # of hits on Carrier */
 call writeln(data,'0')    /* # of hits on Battleship */
 call writeln(data,'0')    /* # of hits on Destroyer */
 call writeln(data,'0')    /* # of hits on Sub */
 call writeln(data,'0')    /* # of hits on PT Boat */
 call writeln(data,'0')    /* # of ships sunk so far */
 call writeln(data,'')
 call writeln(data,'')
 call writeln(data,date())
 call writeln(data,'0')
 call close(data)
 justsetup = 1
return

setships:
 arg shiptype spotlimit spots
 starta = random(1,20,time('s'))
 if starta > 0 & starta < 11 then direction = 'V'
 else do
  direction = 'H'
  if starta = 11 then starta = 'A'
  if starta = 12 then starta = 'B'
  if starta = 13 then starta = 'C'
  if starta = 14 then starta = 'D'
  if starta = 15 then starta = 'E'
  if starta = 16 then starta = 'F'
  if starta = 17 then starta = 'G'
  if starta = 18 then starta = 'H'
  if starta = 19 then starta = 'I'
  if starta = 20 then starta = 'J'
  end
 startb = random(1,spotlimit,time('s'))
 if direction = 'V' then do
  if startb = 1 then shstring = 'A B C D E F G H I J'
  if startb = 2 then shstring = 'B C D E F G H I J'
  if startb = 3 then shstring = 'C D E F G H I J'
  if startb = 4 then shstring = 'D E F G H I J'
  if startb = 5 then shstring = 'E F G H I J'
  if startb = 6 then shstring = 'F G H I J'
  if startb = 7 then shstring = 'G H I J'
  if startb = 8 then shstring = 'H I J'
  if startb = 9 then shstring = 'I J'
  end
 if direction = 'V' then do
  do r = 1 to spots
   let.r = word(shstring,r)
   end
  if shiptype = 'C' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta' 'let.4''starta' 'let.5''starta''
  if shiptype = 'B' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta' 'let.4''starta''
  if shiptype = 'D' | shiptype = 'S' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta''
  if shiptype = 'P' then pos.shiptype = ''let.1''starta' 'let.2''starta''
  end
 else do
  if shiptype = 'C' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2' 'starta''startb +3' 'starta''startb + 4''
  if shiptype = 'B' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2' 'starta''startb +3''
  if shiptype = 'D' | shiptype = 'S' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2''
  if shiptype = 'P' then pos.shiptype = ''starta''startb' 'starta''startb + 1''
  end


if shiptype ~= 'C' then do
 do w = 1 to words(pos.shiptype)
  testword = word(pos.shiptype,w)
  do u = 1 to words(used)
   usedword = word(used,u)
   if testword = usedword then call setships shiptype spotlimit spots
   end
  end
 end
used = ''pos.c' 'pos.b' 'pos.d' 'pos.s' 'pos.p''
return

readstr: procedure
str=''
out=readch(STDIN)
 call WRITECH(STDOUT,out)
 do while out~=D2C(13)
      if out=D2C(8) then do
         str=SUBSTR(str,1,LENGTH(str)-1)
         call WRITECH(STDOUT,' ')
         call WRITECH(STDOUT,out)
         end
      else
         str=INSERT(str,out)
      out=readch(STDIN)
      call WRITECH(STDOUT,out)
    end
say '0D'x
return(UPPER(str))

prompt: procedure
parse arg str
writech(STDOUT,str)
return 1

/********************************************************************/

instring: procedure
arg letter,string
 if (index(string,letter) == 0) then return 0
  else return 1

pressreturn:
prompt(''pen5' Press return to continue'def'')
out=readch(STDIN)
return

SAC70:  /* SAY CENTER TEXT*/
PARSE ARG string
SAY CENTER(string,75)||CR
RETURN;


SYNTAX:
   SAY '*BOOM*  Got a syntax error.  PLEASE notify the sysop.'
   SAY 'Line:' SIGL '   Error Code:' RC

BREAK_C:
BREAK_E:
SAY
exit